perm filename GEOMED[G,BGB] blob
sn#079641 filedate 1974-01-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00043 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00042 PAGES
C00011 00002 TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
C00014 00003 EDITOR STATUS.
C00017 00004 START ADDRESS INITIALIZATION-------------------------------------
C00019 00005 LANGUAGE COMPATIBLITY ROUTINES.
C00021 00006 ASCII 00 TO 37--------------------------------------------------
C00024 00007 ASCII 40 TO 100-------------------------------------------------
C00027 00008 ASCII 101 TO 132 UPPER CASE-------------------------------------
C00030 00009 VBODY: MAKE VERTEX BODY.
C00033 00010 MIDPOI: "M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
C00035 00011 EUTRAN: Apply a Euclidean transformation to an object.
C00037 00012 ----- EUTRAN MAKE REFERENCE FRAME.
C00040 00013 SWITCH COMMANDS.
C00043 00014 STACK MODIFYING COMMANDS. "↔↓↑"
C00045 00015 STRENGTH COMMANDS.
C00048 00016 XSWEEP:
C00050 00017 XKILL: "K"
C00052 00018 LINKER: LINK FOLLOWING COMANDS.
C00054 00019 ----- LINKER OTHER LINK COMMANDS.
C00057 00020 COMMANDS XNAME,XBODY "B","N"
C00059 00021 SUBR(RDNAME)
C00061 00022 INSTANT:
C00063 00023 XDPY:
C00066 00024 W - MAKE WINDOW IN "NOW" DISPLAY RING.
C00069 00025
C00072 00026 XTEXT: TEXT COMMAND.
C00074 00027 EXTEND: "X"-EXTEND COMMANDS.
C00076 00028 EXTEND COMMAND EXECUTIONS.
C00078 00029 XSEK:
C00079 00030 XSCROL: SCROLL CAMERA VISIBLE EDGES.
C00081 00031 XCOLOR: COLORING X-COMMAND.
C00084 00032
C00088 00033 SUBR(STADPY) STATUS DISPLAY
C00090 00034 ----- STADPY TRANSLATION STRENGTH.
C00092 00035 ----- STADPY DISPLAY THE SCRATCH PAD PDL.
C00094 00036 SUBR(NTYPE,NODE) FETCH NODE TYPE NUMBER 0 TO 17.
C00096 00037 TABLES REL,CONTYP,NNAMES,NLETTER Node Info. Tables
C00099 00038 NODE CONTENT TYPES.
C00101 00039 SUBR(DPYNODE,NODE) DISPLAY NODE CONTENTS.
C00103 00040 FULL WORD.
C00105 00041 SUBR(VDPY,VERTEX) SPECIAL VERTEX DISPLAY *
C00107 00042 SUBR(FDPY,FACE) Special Face display *
C00109 00043 SUBR(IDPY,NODE) Identifier display. *
C00111 ENDMK
C⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
SUBR GEOMED ;TELETYPE COMMAND JUMP TABLE
COMMENT ⊗------------------------------------------------------------
⊗
CALL(EXITQ.)
L2: CALL(STADPY) ;STATUS DISPLAY.
LAC ALPHA↔DAC CTRL↔DZM ALPHA
LAC BETA ↔DAC META↔DZM BETA
CALL(GETCW0)
TRZE 200↔DOM CTRL ;CONTROL-KEY FLAG.
TRZE 400↔DOM META ;META-KEY FLAG.
CAIN 0,15↔GO[DZM ITERAT↔GO L2] ;CARRIAGE RETURN.
CAIN 0,12↔GO[OUTCHR["*"]↔GO L2] ;LINE-FEED.
DAC 0,CHR
LAC CTRL↔AND META↔DAC MTCT ;META-CONTROL FLAG.
SETZ↔SKIPE CTRL↔IORI 1
SKIPE META↔IORI 2↔DAC MCBITS ;META-CONTROL BITS.
;READ JUMP TABLE.
LAC CHR↔DAC 1
CAIG 0,140↔GO[CAR 1,A00(1)↔GO L3]
CAIG 0,172↔GO[CAR 1,A00-40(1)↔GO L3]
CAR 1,A173-173(1)
L3: PUSHJ P,(1) ;CALL GEOMED COMMAND - THE CHARACTER IS IN AC0.
GO L2
ENDR GEOMED;2/4/73(BGB)----------------------------------------------
;COMMON EXITS FOR COMMAND EXECUTION ROUTINES.
↑EXITQ.: CALL(GEODPY)
↑EXIT1.: CRLF↔OUTCHR["*"] ;THE MAIN CRLF STAR.
↑EXIT0.: POPJ P, ;COMMON POP0J.
↑EXITR.: CALL(GEODPY)↔POPJ P, ;EXIT AND REFRESH DPY.
↑EXITP.: LAC 2,PDLPTR ;EXIT PDL PUSH REFRESH.
PUSH 2,1↔DAC 2,PDLPTR
CALL(GEODPY)↔GO EXIT1.
DEFINE EXIT0{GO EXIT0.}
DEFINE EXIT1{GO EXIT1.}
DEFINE EXITP{GO EXITP.}
DEFINE EXITQ{GO EXITQ.}
DEFINE EXITR{GO EXITR.}
NOP: OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]↔CRLF↔EXIT0
QMARK: CALL(GETCW0)↔DAC 1
CAIG 0,140↔GO[CDR 1,A00(1)↔GO L4]
CAIG 0,172↔GO[CDR 1,A00-40(1)↔GO L4]
CDR 1,A173-173(1)
L4: CRLF↔OUTCHR[" "]
OUTSTR(1)↔EXIT1 ;PRINT GEOMED COMMAND CHARACTER COMMENT.
;EDITOR STATUS.
PDL↑: BLOCK =500 ;GEOMED'S INTERNAL STACK.
PDLIOWD: XWD PDL-.,PDL-1
PAT↑: BLOCK 40
PDLPTR↑: XWD -100,PADPDL ;GEOMED'S GRAPHICS STACK.
PADPDL: BLOCK 100
↓PTR←←16 ;PADPDL STACK POINTER AC.
;JUMP TABLE COMMAND SCANNER STATUS.
DECLARE{CHR,MCBITS,CTRL,META,MTCT,ALPHA,BETA}
INTERN CTRL,META
;STRENGTH OF EUCLIDEAN TRANSFORMATION.
TDEL: 1.0 ;TRANSLATION DELTA STRENGTH.
RDEL: 0.785398;ROTATION DELTA STRENGTH.
DDEL: 0↔0.75 ;DILATION DELTA STRENGTH.
OPERAT: 0 ;DEFAULT EUCLIDEAN OPERATION.
FRAAM: 0 ;FRAME OF REFERENCE.
FRMORG: 0 ;USE FRAME OF REFERENCE ORIGIN.
AXECNT: 1 ;NUMBER OF AXES TO USE.
ITERAT: 0 ;NUMBER OF ITERATIONS.
FLAGL: -1 ;"L" COMMAND SWITCH. LABEL LIGHTS.
FLAGD: 0 ;"∂" NODE DISPLAY ENABLE.
FLAGSD: -1 ;"≡" STATUS DISPLAY ENABLE.
DPYFLG↑:2 ;GEODPY STICKY DISPLAY MODE.
ODPYFLG: 2 ;OLD GEODPY STICKY DISPLAY MODE.
;IO OPERATIONS
EXTERN GETCHW ;GET A CHARACTER (IN CHARACTER MODE FOR TTY)
EXTERN GETCHL ;GET A CHARACTER (IN LINE MODE FOR TTY)
EXTERN GETCL0,GETCW0 ;SAME EXCEPT RETURNS RESULT IN 0 INSTEAD 1.
;WING OPERATIONS.
EXTERN MKB,MKF,MKE,MKV,MKFRAME
EXTERN KLB,KLF,KLE,KLV,WING
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER,OTHER.
EXTERN BGET,FCW,FCCW,VCW,VCCW
;EULER OPERATIONS.
EXTERN MKEV,MKFE
INTERN CAMERA↔CAMERA:0
WORLD:0
WINDOW:0
EXTERN KLNODE,UNIVER,OLD44,AVAIL
VERNX←←14 ↔ VERNY←←11
;START ADDRESS INITIALIZATION-------------------------------------
SUBR(GEONIT)
GO SA2
ENDR GEONIT
SA: JFCL↔SETOM ALONE#
SKIPE 1,OLD44↔CORE 1,↔JFCL↔SETZM OLD44 ;CORE DOWN.
SKIPA 17,PDLIOWD
SA2: SETZM ALONE
;CREATE A GEOMED UNIVERSE.
SETZM UNIVERSE
SETZM BLKCNT↑
SETZB AVAIL ;...SO THAT @AVAIL IS ZERO.
CALL(MKUNIV↑)
;SETUP STRENGTH OF TRANSFORMATION VALUES.
LAC[1.0]↔DAC TDEL ;TRANSLATION STRENGTH.
LAC[0.75]↔DAC DDEL ;DILATION STRENGTH.
LAC[0.785398]↔DAC RDEL ;ROTATION STRENGTH π/4.
SETZM FRAAM ;SELECT WORLD FRAME.
SETZM FRMORG
SETOM FLAGL ;TURN ON THE LIGHTS.
LACI 1↔DAC AXECNT ;ONE AXIS SELECT.
SETZM OPERAT ;TRANSLATION DEFAULT.
LAC[XWD -100,PADPDL]↔DAC PDLPTR
SKIPN ALONE↔POP0J
;RE-ENTRY ADDRESS INITIALIZATION----------------------------------
REE: LACI .↔DAC 124
LAC 17,PDLIOWD
OPDEF PPIOT[702B8]
OUTCHR[14]↔PGIOT 2, ;CLEAR PIECES OF GLASS
PPIOT 2,-=250↔PPIOT 3,3003
MOVEI 0,2↔MOVEM 0,DPYFLG ;TURN OFF HIDDEN LINES
PUSHJ P,[GO TRAPINIT↑]
CALL(GEODPY↑)
CALL(GEOMED)
EXIT↔LIT
;2/4/73-----------------------------------------------------------
;LANGUAGE COMPATIBLITY ROUTINES.
;--------------------------------------------------------------------
IFN SAIL{
ENTRY.↑: 0 ;SAIL TO GEM.
DAC 12,SAIL12#
DAC 16,SAIL16#
DAC 17,SAIL17# ;USING SAIL'S PDL.
GO@ENTRY.
EXIT.↑: 0 ;GEM TO SAIL.
LAC 12,SAIL12
LAC 16,SAIL16
LAC 17,SAIL17
GO@EXIT.
ENTERS↑: -1↔ LIT}
;--------------------------------------------------------------------
;LISP ACCUMULATOR PROTECTION - 0,14,15,16,17.
IFN LISP{
DEFINE NUMVAL(AC){
TRNE AC,400000↔GO .+4
CDR AC,(AC)↔CDR AC,(AC)↔SKIPA AC,(AC)
SUBI AC,577777}
ENTRY.↑:0 ;LISP TO GEM.
DAC 0,LISP0↔LAC[XWD 5,LISP0+5]
BLT 0,LISP0+17↔LAC 17,PDLIOWD
CDR ENTRY.↔SUBI 3↔CAR@↔ANDI 7 ;NUMBER OF ARGUMENTS.
JUMPE @ENTRY.
NUMVAL(1)↔PUSH P,1↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(2)↔PUSH P,2↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(3)↔PUSH P,3↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(4)↔PUSH P,4↔SOSG↔PUSHJ P,@ENTRY.
SKIPA
EXIT.↑: 0 ;GEM TO LISP.
LAC 0,[XWD LISP0+5,5]↔BLT 0,17
LAC 0,LISP0
LACI 2,FIXNUM↑↔TLNE 1,-1↔LACI 2,FLONUM↑
GO MAKNUM↑
ENTERS↑: -1↔LISP0:BLOCK 20}
;--------------------------------------------------------------------
;ASCII 00 TO 37--------------------------------------------------
DEFINE $$(Q,A,B){XWD A,[ASCIZ"B"]}
A00: NOP ;null.
$$("↓",PADPSH,{ ↓ COPY PUSH. α↓ ROTATE PUSH.})
$$("α",{[SETOM ALPHA↔POP0J]},{α CONTROL KEY PREFIX.})
$$("β",{[SETOM BETA↔POP0J]},{β META KEY PREFIX.})
$$("∧",LINKER,{ ∧ FETCH PVT LINK})
$$("¬",XEVERT,{ ¬ BODY EVERT. α¬ BODY SUBTRACTION.})
$$("ε",{[SETOM ALPHA↔SETOM BETA↔POP0J]},{ε META-CONTROL PREFIX.})
$$("π",XRDEL,{ π ACCEPT ROTATION DELTA.})
$$("λ",XTDEL,{ λ ACCEPT TRANSLATION DELTA.})
$$(" ",NOP,{ TAB.})
$$(" ",NOP,{ LF.})
$$(" ",NOP,{ VT.})
$$(" ",NOP,{ FF.})
$$(" ",NOP,{ CR.})
$$("∞",INSTANT,{ ∞ INSTANT CUBE. α∞ INSTANT TORUS.})
$$("∂",SWCD,{ ∂ FLIP NODE DISPLAY SWITCH.})
$$("⊂",LINKER,{ ⊂ FETCH BRO LINK.})
$$("⊃",LINKER,{ ⊃ FETCH SIS LINK.})
$$("∩",LINKER,{ ∩ FETCH DAD LINK, α∩ BODY INTERSECTION.})
$$("∪",LINKER,{ ∪ FETCH SON LINK, α∪ BODY UNION.})
$$("∀",XDISBL,{ ∀ DISABLE BODY OPERATIONS SWITCH.})
$$("∃",SWC4,{ ∃ REFLECTION DEFAULT.})
$$("⊗",LINKER,{ ⊗ FETCH UNIVERSE NODE.})
$$("↔",PADSWP,{(1ST ↔ 2ND)(1ST α↔ 3RD)(1ST β↔ LAST)(2ND ε↔ 3RD)})
$$("_",XDPY,{ _ STICKY DISPLAY MODE SWITCH.})
$$("→",LINKER,{ → FETCH ALT2 LINK.})
$$("~",NOP,{ TILDE})
$$("≠",NOP,{ ≠})
$$("≤",LINKER,{ ≤ FETCH NED LINK.})
$$("≥",LINKER,{ ≥ FETCH PED LINK.})
$$("≡",SWCSD,{ TOGGLE: ≡ STATUS DISPLAY, α≡ BORDER DISPLAY.})
$$("∨",LINKER,{ ∨ FETCH NVT LINK.})
;----------------------------------------------------------------
;ASCII 40 TO 100-------------------------------------------------
$$(" ",XREDPY,{ REFRESH DISPLAY.})
$$("!",SWC1,{ ! TRANSLATION DEFAULT SWITCH.})
$$(" ",NOP,{ NOP - DOUBLE QUOTE.})
$$("#",CRLF20,{ # TWENTY CRLF'S. α# ENTER DDT.})
$$("$",XCONVEX,{ $ MAKE CONVEX. α$ ESLURP })
$$("%",XDDEL,{ % SET DILATION DELTA STRENGTH.})
$$("&",NOP,{ & NOP.})
$$("'",NOP,{ ' NOP.})
$$("(",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Y.})
$$(" ",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Y.})
$$("*",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Z.})
$$("+",LINKER,{ OTHER LINK.})
$$(" ",LINKER,{ CLOCKWISE LINK.})
$$("-",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Z.})
$$(".",LINKER,{ COUNTER CLOCKWISE LINK.})
$$("/",HALVE ,{ HALVE STRENGTH.})
$$("0",SETDIG,{ SET-DIGIT COMMAND.})
$$("1",SETDIG,{ SET-DIGIT COMMAND.})
$$("2",SETDIG,{ SET-DIGIT COMMAND.})
$$("3",SETDIG,{ SET-DIGIT COMMAND.})
$$("4",SETDIG,{ SET-DIGIT COMMAND.})
$$("5",SETDIG,{ SET-DIGIT COMMAND.})
$$("6",SETDIG,{ SET-DIGIT COMMAND.})
$$("7",SETDIG,{ SET-DIGIT COMMAND.})
$$("8",SETDIG,{ SET-DIGIT COMMAND.})
$$("9",SETDIG,{ SET-DIGIT COMMAND.})
$$(":",EUTRAN,{ EUCLIDEAN TRANSFORMATION +X.})
$$(";",EUTRAN,{ EUCLIDEAN TRANSFORMATION -X.})
$$("<",LINKER,{ FETCH NFACE LINK.})
$$("=",SWC3,{ DILATION DEFAULT SWITCH.})
$$(">",LINKER,{ FETCH PFACE LINK.})
$$("?",QMARK,{ INFORMATION PREFIX.})
$$("@",SWC2,{ ROTATION DEFAULT SWITCH.})
;----------------------------------------------------------------
;ASCII 101 TO 132 UPPER CASE-------------------------------------
;ASCII 141 TO 172 LOWER CASE.
A101:
$$("A",ATTDET,{ A ATTACH, αA ARROW, βAXECNT.})
$$("B",XBODY ,{ B BODY RETRIEVAL.})
$$("C",XCOPY ,{ C COPY. αC GET CAMERA.})
$$("D",ATTDET,{ D DETACH, αDARKEN, βDUAL, εUNDARKEN.})
$$("E",SWIRE ,{ E SWEEP WIRE, εE EXIT.})
$$("F",SWCF,{ F FRAME STEP SWITCH.})
$$("G",XGLUE,{ G GLUE COMMAND.})
$$("H",COMHLP,{ H HELP. αH NO HELP.})
$$("I",XIN,{ I INPUT B3D. αI CAMERA. βI CRE. εI D3D.})
$$("J",JOINVV,{ J JOIN VERTEX-VERTEX.})
$$("K",XKILL,{ K KILL COMMANDS.})
$$("L",SWCL,{ L LABEL LIGHTS SWITCH.})
$$("M",MIDPOI,{ M MIDPOINT COMMAND.})
$$("N",XNAME,{ N NAME BODY.})
$$("O",XOUT,{ O OUTPUT B3D. αO CAMERA. βO TRI FOR MAKVID. εO D3D.})
$$("P",XPLOTO,{ P OUTPUT PLOT FILE})
$$("Q",SWCQ,{ Q FRAME ORIGIN SWITCH.})
$$("R",XROTCM,{ R ROTATION COMPLETION.})
$$("S",XSWEEP,{ S SWEEP. αS PYRAMID. βS SMOOTH SWEEP. εSMOOTH PYRAMID.})
$$("T",XTEXT,{ T TEXT LABEL. αT TAKE A PICTURE. εβ TRIANGLE SWEEP.})
$$("U",NOP,{ U NOP})
$$("V",VBODY,{ V MAKE VERTEX BODY.})
$$("W",XWMAKE,{ MAKE: W WINDOW. αW WINDOW-DISPLAY. βW WORLD.})
$$("X",EXTEND,{X EXTENDED COMMANDS.})
$$("Y",NOP,{ Y NOP})
$$("Z",NOP,{ Z MACRO CALL, αZ EDIT MACRO, βZ TAKE COMMANDS FROM FILE.})
;ASCII 133 TO 140.
$$("[",NOP,{ NOP})
$$("\",DOUBLE,{ \ DOUBLE STRENGTH.})
$$("]",NOP,{ NOP})
$$("↑",PADPOP,{ ↑ PADPDL POP. α↑ ROTATE POP.})
$$("←",LINKER,{ ← FETCH ALT LINK.})
$$("`",NOP,{ NO OP.})
A173:
$$("{",XSTEP,{ STEP NOW: DISPLAY, αWORLD, βCAMERA.})
$$("|",XINVERT,{ | INVERT EDGE PARITY.})
$$(" ",XDPY,{ ALT OCCULT. αALT FRONT FACE. βALT ALL EDGES.})
$$("}",XSTEP,{ STEP NOW: DISPLAY, αWORLD, CAMERA OF β WORLD, OF ε WINDOW.})
$$(" ",NOP,{ RUBOUT})
;----------------------------------------------------------------
LIT
VBODY:; ;MAKE VERTEX BODY.
BEGIN VBODY
LAC PTR,PDLPTR
SETQ(BNEW,{MKB,WORLD})
PUSH PTR,1 ;BODY INTO PADPDL
SKIPE META↔GO L1 ;DISABLE FACE & VERTEX.
CALL(MKF,BNEW)↔PUSH PTR,1 ;FACE INTO PADPDL
CALL(MKV,BNEW)↔PUSH PTR,1 ;VERTEX INTO PADPDL
L1: DAC PTR,PDLPTR
SKIPE CTRL↔EXIT0 ;DISABLE MAKE FRAME.
CALL(MKFRAME)↔LAC 2,BNEW
FRAME. 1,2↔EXIT0
DECLARE{BNEW}
BEND VBODY;2/4/73(BGB)------------------------------------------------
SWIRE:
CDR 2,PDLPTR
SKIPN MTCT↔GO .+4↔POP P,0
LAC 1,(2)↔POP0J ;"εE" - EXIT GEOMED.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+2↔EXIT0 ;PADPDL EMPTY TEST.
CALL(LINKED,{-1(PTR)},{(PTR)}) ;LEGAL ARGS TEST.
SKIPN 1↔EXIT0
LAC PTR,PDLPTR
CALL(MKEV,{-1(PTR)},{(PTR)}) ;MAKE EDGE VERTEX.
LAC PTR,PDLPTR↔DAC 1,(PTR)
EXIT0
JOINVV:
BEGIN JOINVV
ACCUMULATORS{F,V1,V2,E1,E2}
LAC PTR,PDLPTR↔CDR 1,PTR
CAIGE 1,PADPDL+2↔EXIT0 ;REQUIRES TWO ARGUMENTS.
LAC V1,(PTR)
LAC V2,-1(PTR)↔DAC V2,F
TEST V1,VBIT↔EXIT0 ;AT LEAST ONE VERTEX.
TEST F,FBIT↔GO L1
;JOIN ENDS OF WIRE CASE.
PED E1,F↔PVT V2,E1↔DAC V2,(PTR)
CALL(MKFE,V2,F,V1)
EXITR
;JOIN VERTICES ACROSS A FACE.
L1: TEST V2,VBIT↔EXIT0
PED E1,V1↔DAC E1,E0#
L2: SETQ(F,{FCCW,E1,V1})
PED E2,V2↔DAC E2,EE0#
L3: CALL(FCCW,E2,V2)↔CAMN 1,F↔GO L4 ;FACE IN COMMON.
SETQ(E2,{ECCW,E2,V2})↔CAME E2,EE0↔GO L3
SETQ(E1,{ECCW,E1,V1})↔CAME E1,E0↔GO L2↔EXIT0
L4: POP PTR,0↔DAC PTR,PDLPTR
CALL(MKFE,V1,F,V2)
EXITP
BEND JOINVV;2/5/73(BGB)
MIDPOI: ;"M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
BEGIN MIDPOI;---------------------------------------------------------
CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔EXIT0
LAC 1,(PTR)↔TEST 1,EBIT↔EXIT0
PVT 0,1↔DAC V1
NVT 0,1↔DAC V2
CALL(ESPLIT↑,1)↔DAC 1,(PTR)
LAC 2,V1↔SLACI XWC(2)↔LAPI XWC(1)↔BLT ZWC(1)
LAC DDEL↔FMPRM XWC(1)↔FMPRM YWC(1)↔FMPRM ZWC(1)
LAC 2,V2↔SLACI 3,(1.0)↔FSBR 3,DDEL
LAC XWC(2)↔FMPR 3↔FADRM XWC(1)
LAC YWC(2)↔FMPR 3↔FADRM YWC(1)
LAC ZWC(2)↔FMPR 3↔FADRM ZWC(1)
EXITR
DECLARE{V1,V2}
BEND MIDPOI;2/8/73(BGB)----------------------------------------------
XINVERT: ;"|" FLIP THE FACE-VERTEX ORIENTATION OF AN EDGE.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔EXIT0
LAC 1,(PTR)
TEST 1,EBIT↔EXIT0
MOVSS 1(1)↔MOVSS 3(1)↔MOVSS 4(1)↔MOVSS 5(1)
EXIT0
XEVERT: ;"α¬" BODY SUBTRACTION.
SKIPE CTRL↔JFCL ; "¬" BODY EVERT.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔EXIT0
LAC 1,(PTR)↔TEST 1,BBIT↔EXIT0
CALL(EVERT↑,1)
EXITR
EUTRAN: ;Apply a Euclidean transformation to an object.
BEGIN EUTRAN;--------------------------------------------------------
EXTERN BGET,APTRAN,MKFRAME,MKCOPY,KLNODE
EXTERN TRANSLATE,ROTATE,SHRINK
;GET TOP OBJECT OF PADPDL.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
LAC 2,(1)↔DAC 2,OBJECT
$TYPE 0,2↔CAIN 0,$WINDOW↔GO WNTRAN
DZM DEL1↔DZM DEL2↔DZM DEL3
;OPERATION.
SKIPN 1,MCBITS↔LAC 1,OPERAT↔DAC 1,OP
LAC 2,[TRANSLATE↔ROTATE↔SHRINK↔SHRINK](1)
DAP 2,L3
;AXIS CODE.
LAC 1,CHR↔SETZ 3,
CAIE 1,";"↔CAIN 1,":"↔IORI 3,1 ;X-AXIS.
CAIE 1,"("↔CAIN 1,")"↔IORI 3,2 ;Y-AXIS.
CAIE 1,"-"↔CAIN 1,"*"↔IORI 3,4 ;Z-AXIS.
LAC 1,OP↔CAILE 1,1↔GO[ ;DILATION DELS.
SLACI(1.0)↔DAC DEL1↔DAC DEL2↔DAC DEL3
LAC AXECNT↔CAIN 2↔TRC 3,7 ;DILATION AXES.
CAIN 3↔TRO 3,7↔GO .+1]
;DELTA ARGUMENT.
LAC CHR↔LAC 1,OP
LAC 2,@[TDEL↔RDEL↔DDEL↔[-1.0]](1)
CAIN"-"↔MOVNS 2
CAIN"("↔MOVNS 2
CAIN";"↔MOVNS 2
GO@[L1↔L1↔[MOVNS 2↔JUMPGE 2,L1 ;NEGATIVE DILATION.
SLACI 2,(1.0)↔FDVR 2,DDEL↔GO L1] ;POSITIVE DILATION.
[LAC 2,[-1.0]↔GO L1]](1) ;REFLECTION DELTA.
L1: TRNE 3,1↔DAC 2,DEL1
TRNE 3,2↔DAC 2,DEL2
TRNE 3,4↔DAC 2,DEL3
;----- EUTRAN ;MAKE REFERENCE FRAME.
LAC 1,FRAAM↔GO@[[GO .+1] ;WORLD FRAME.
[CALL(BGET,OBJECT)↔GO .+1] ;BODY FRAME.
[CALL(BGET,OBJECT)↔DAD 1,1↔GO .+1] ;DADDY'S FRAME.
[LAC 1,CAMERA↔GO .+1]](1) ;CAMERA FRAME.
SKIPE 1↔FRAME 1,1
SKIPE 1↔GO[CALL(MKCOPY,1)↔GO .+1] ;COPY OF REFRAM.
DIPZ 1,REFRAM ;XWD REFRAM,0
;FRAME ORIGIN SWITCH.
SKIPN FRMORG↔GO[SKIPN OP↔GO .+1 ;NON-TRANSLATION.
CALL(BGET,OBJECT)↔FRAME 1,1
JUMPE 1,.+1↔PUSH P,1
CAR 1,REFRAM↔SKIPN 1↔CALL(MKFRAME)↔DIPZ 1,REFRAM
LAC 2,1↔POP P,1↔SLACI XWC(1)
LAPI XWC(2)↔BLT ZWC(2)↔GO .+1]
;MAKE EUCLIDEAN TRANSFORMATION MATRIX.
CALL(,REFRAM,DEL1,DEL2,DEL3)
L3: CALL(ROTATE)↔DAC 1,TRAN ;MAKE THE TRANSFORM.
SKIPE REFRAM↔GO[CAR REFRAM↔CALL(KLNODE,0)↔GO .+1];FLUSH THE REFRAM.
LAC ITERAT↔SKIPN↔AOS↔DAC COUNT
L2: CALL(APTRAN,OBJECT,TRAN)
CALL(GEODPY)
SKIPGE COUNT↔GO[
AOSL COUNT↔GO .+1
SETZM ITERAT
CALL(XSWEEP)
CDR 1,PDLPTR↔LAC(1)↔DAC OBJECT↔GO L2]
SOSLE COUNT↔GO L2
SETOM@TRAN
CALL(KLNODE,TRAN)
EXIT0
DECLARE{OBJECT,TRAN,REFRAM,COUNT,OP,DEL1,DEL2,DEL3}
WNTRAN: LAC 1,CHR ;WINDOW TRANFORMATION.
CAIN 1,"-"↔GO[LAC -1(2)↔FMPR DDEL↔DAC -1(2)
SKIPE CTRL↔GO W2↔GO W1]
CAIN 1,"*"↔GO[LAC -1(2)↔FDVR DDEL↔DAC -1(2)
SKIPE CTRL↔GO W2↔GO W1]
LAC 3,TDEL↔FMPRI 3,(<100.0>)↔FIXX 3, ;TRANSLATION.
LACI 4,-2(2)↔SKIPE CTRL↔SOS 4 ;ADDRESS.
CAIN 1,";"↔GO[NIP(4)↔SUB 3↔DIP(4)↔GO W1]
CAIN 1,":"↔GO[NIP(4)↔ADD 3↔DIP(4)↔GO W1]
CAIN 1,"("↔GO[NAP(4)↔SUB 3↔DAP(4)↔GO W1]
CAIN 1,")"↔GO[NAP(4)↔ADD 3↔DAP(4)↔GO W1]
EXIT0
W1: CALL(CROP↑,2)
W2: CALL(GEODPY)↔EXIT0
BEND EUTRAN;2/4/73(BGB)-----------------------------------------------
;SWITCH COMMANDS.
; ! TRANSLATION DEFAULT.
; @ ROTATION DEFAULT.
; ∃ REFLECTION DEFAULT.
; = DILATION DEFAULT.
; Q FLIP FRAME ORIGIN.
; F STEP FRAME SELECT SWITCH.
; ≡ TOGGLE STATUS DISPLAY ENABLE.
SWC1: SETZM OPERAT↔EXIT0 ;"!" TRANSLATION DEFAULT.
SWC2: LACI 1↔DAC OPERAT↔EXIT0 ;"@" ROTATION DEFAULT.
SWC3: LACI 2↔DAC OPERAT↔EXIT0 ;"=" DILATION DEFAULT.
SWC4: LACI 3↔DAC OPERAT↔EXIT0 ;"∃" REFLECTION DEFAULT.
SWCF: SKIPE CTRL↔GO XFOCAL ;"αF" SET FOCAL.
SKIPE META↔SOSA 1,FRAAM
AOS 1,FRAAM↔ANDI 1,3
DAC 1,FRAAM↔EXIT0 ;FRAME STEP SWITCH.
SWCL: SETCMM FLAGL↔EXIT0 ;"L" LABEL LIGHTS SWITCH.
SWCD: SETCMM FLAGD↔EXIT0 ;"∂" NODE DISPLAY SWITCH.
SWCQ: SETCMM FRMORG↔EXIT0 ;FRAME ORGIN TOGGLE.
SWCSD: SKIPE CTRL↔GO .+3
SETCMM FLAGSD↔EXIT0 ;"≡" STATUS DISPLAY TOGGLE.
LAC 1,UNIVERSE↔CW 1,1
LAC(1)↔TLC(DARKEN)↔DAC(1)↔EXITR ;"α≡" TOGGLE WINDOW BORDER.
CRLF20: SKIPE CTRL↔GO .+3
OUTSTR[BYTE(7)14,14]↔EXIT0 ;"#" TWENTY CRLF'S.
SKIPN JOBDDT↑↔GO[OUTSTR[ASCIZ/ NO DDT./]↔EXIT]
CALL(DDTGO↑)↔EXIT1 ;"α#" ENTER DDT.
XDISBL: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
LAC 1,(1)↔TEST 1,BBIT↔EXIT0
LAC 2,MCBITS↔GO@[
[MARKZ 1,{BDLBIT+BDVBIT+BDPBIT}↔EXIT0] ;ENABLE.
[MARK 1,BDLBIT↔EXIT0] ;FRAME DISABLE
[MARK 1,BDVBIT↔EXIT0] ;VERTEX DISABLE
[MARK 1,BDPBIT↔EXIT0]](2) ;PARTS DISABLE
;STACK MODIFYING COMMANDS. ;"↔↓↑"
;"↔" PADPDL SWAP: PADPDL[1]↔PADPDL[2].
;"α↔" PADPDL SWAP: PADPDL[1]↔PADPDL[3].
;"β↔" PADPDL SWAP: PADPDL[2]↔PADPDL[3].
;"ε↔" PADPDL SWAP: PADPDL[1]↔PADPDL[N].
PADSWP: LAC PTR,PDLPTR↔CDR PTR
LACM 1,CTRL↔CAIGE PADPDL+2(1)↔EXIT0 ;ARG ∃ TEST.
LAC 1,MCBITS↔GO@[
[LAC(PTR)↔EXCH -1(PTR)↔DAC(PTR)↔EXIT0] ; 1ST & 2ND.
[LAC(PTR)↔EXCH -2(PTR)↔DAC(PTR)↔EXIT0] ;α 1ST & 3RD.
[LAC(PTR)↔EXCH PADPDL+1↔DAC(PTR)↔EXIT0] ;β 1ST & LAST.
[LAC -1(PTR)↔EXCH -2(PTR)
DAC -1(PTR)↔EXIT0] ;ε 2ND & 3RD.
](1)↔LIT
;"↓" PADPDL COPY PUSH DOWN.
;"↓" PADPDL ROTATE DOWN.
PADPSH: LAC PTR,PDLPTR↔CDR PTR
CAIGE PADPDL+1↔EXIT0
SKIPE CTRL↔GO .+4
PUSH PTR,(PTR)↔DAC PTR,PDLPTR↔EXIT0 ;COPY PUSH.
LAC[XWD PADPDL+1,PADPDL]↔BLT -1(PTR)
LAC PADPDL↔DAC(PTR)↔EXIT0 ;ROTATE PUSH.
;"↑" PADPDL POP UP.
;"α↑" PADPDL ROTATE UP.
PADPOP: LAC PTR,PDLPTR↔CDR PTR
CAIGE PADPDL+1↔EXIT0
SKIPE CTRL↔GO .+4
POP PTR,↔DAC PTR,PDLPTR↔EXIT0 ;PAD POP.
SUBI PADPDL↔POP PTR,1(PTR)↔SOJG .-1 ;ROTATE POP
LAC PTR,PDLPTR↔LAC 1(PTR)↔DAC PADPDL+1
EXIT0
;STRENGTH COMMANDS.
;"/" COMMAND.-----------------------------------------------------
HALVE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC -1↔DAC TDEL(1) ;"/" COMMAND.
EXIT0
;"\" COMMAND.-----------------------------------------------------
DOUBLE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC 1↔DAC TDEL(1) ;"\" COMMAND.
EXIT0
;"0123456789" COMMANDS.-------------------------------------------
SETDIG: LAC 1,CHR↔ANDI 1,17 ;DIGIT.
SKIPN 2,MCBITS↔LAC 2,OPERAT ;EUCLIDEAN OPERATION.
GO@[
[LAC ITERAT↔IMULI 12↔ADD 1 ;ITERATION COUNT.
CAILE=128↔LACI=128
DAC ITERAT↔EXIT0]
[SUBI 1,=10↔LAC[3.1415927] ;ROTATION DELTA.
FSC(1)↔DAC RDEL↔EXIT0]
[SKIPN 1↔LACI 1,1↔FLOAT 1, ;DILATION DELTA.
FMPR 1,[0.1]↔DAC 1,DDEL↔EXIT0]
[SUBI 1,4↔SLACI(1.0)↔FSC(1) ;TRANSLATION DELTA.
DAC TDEL↔EXIT0]](2)
;-----------------------------------------------------------------
EXTERNAL REALI
REALIN: GO REALI
XTDEL: CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔DAC TDEL↔EXIT0
XDDEL: CALL(REALIN)↔FMPR[0.01]↔DAC DDEL↔EXIT0
XRDEL: CALL(REALIN)↔CAIN 1,"/"↔GO[
SKIPN↔SLACI(1.0)↔DAC RDEL ;NUMERATOR.
CALL(REALIN)↔SKIPN↔SLACI(1.0) ;DENOMINATOR.
LAC 1,RDEL↔FMPR 1,[3.1415927]
FDVR 1,0↔DAC 1,RDEL↔EXIT0] ;PI FRACTION.
CAIN 1,"'"↔FMPR[1.74532925E-2] ;DEGREES.
DAC RDEL↔EXIT0 ;RADIANS.
;COMMAND XFOCAL
XFOCAL:
OUTSTR[ASCIZ/ FOCAL = /]↔CALL(REALIN)
JUMPE 0,[OUTSTR[ASCIZ/
*/]↔EXIT0] ;Reject zero focal length
LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1
MOVSI 2,(NOTPER)
JUMPL 0,[MOVN 0,0↔ORM 2,(1)↔GO XFOCA1] ;Negative focal length
ANDCAM 2,(1) ;turns off perspective
XFOCA1: FMPR 0,[3.280833E-3]↔LAC 2,0 ;NEW FOCAL IN FEET.
EXCH 2,3(1)↔FDVR 0,2 ;(NEW-FOCAL / OLD-FOCAL).
FMPRM -3(1)↔FMPRM -2(1)↔FMPRM -1(1) ;UPDATE SCALES.
OUTSTR[ASCIZ/*/]↔EXITR
XSWEEP:
BEGIN XSWEEP;--------------------------------------------------------
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔EXIT0 ;ARG EXISTS.
LAC 1,(PTR)↔TESTZ 1,FBIT↔GO L2
TEST 1,VBIT↔EXIT0
PED 2,1↔JUMPE 2,.+4
MOVS 0,1(2)↔CAME 0,1(2)↔GO [ SETOM CTRL↔GO L2A ]
CALL(SWIRE)↔GO L3 ;SWEEP WIRE.
L2: LAC CHR↔CAIN "T"
GO [ SKIPL 2,CTRL
LACI 2,1
GO L2B ]
L2A: SETZ 2,
SKIPE META↔HRLI 2,-1
SKIPE CTRL
GO [ CALL(PYRAMID↑,1)↔DAC 1,(PTR)
CALL(GEODPY)↔EXIT0 ]
L2B: CALL(SWEEP↑,1,2)
L3: MOVNS ITERAT↔EXITR
BEND XSWEEP;2/10/73(BGB)---------------------------------------------
XROTCM:
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔EXIT0
LAC 1,(PTR)↔TEST 1,FBIT↔EXIT0
CALL(ROTCOM↑,1)
EXITR
;--------------------------------------------------------------------
XGLUE: LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+2↔EXIT0 ;TWO ARGS.
LAC 1,(PTR)↔LAC 2,-1(PTR)
CALL(GLUE↑,1,2)↔DAC 1,-1(PTR)
POP PTR,0↔DAC PTR,PDLPTR
EXITR
;____________________________________________________________________
XKILL: ;"K"
BEGIN XKILL: ;-------------------------------------------------------
EXTERN KLEV,KLVE,KLFE,REMOVF,KLBFEV
LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+1↔EXIT0 ;ONE ARG.
LAC 1,(PTR)
TEST 1,VBIT↔GO L2
DAC 1,2↔PED 3,1↔JUMPE 3,L4
SETQ(4,{ECCW,3,2})
SETQ(5,{ECCW,4,2})
DAC 2,1↔CAME 3,5↔GO L1
CALL(KLEV,1)↔GO L3
L1: CALL(KLEV,1)↔CALL(KLFE,1)↔GO L3
L2: TESTZ 1,EBIT↔GO[
SKIPE META↔GO[ CALL(EKILL↑,1)↔GO L3]
SKIPE CTRL↔GO[ CALL(KLVE,1)↔GO L3]
CALL(KLFE,1)↔GO L3]
TESTZ 1,FBIT↔GO[CALL(REMOVF,1)↔GO L3]
TESTZ 1,BBIT↔GO[L4: CALL(KLBFEV,1)↔POP PTR,0
DAC PTR,PDLPTR↔CALL(GEODPY)↔EXIT0]
EXIT0
L3: DAC 1,(PTR)
CALL(GEODPY)
EXIT0
BEND XKILL;2/10/73(BGB)-------------------------------------------------
LINKER: ;LINK FOLLOWING COMANDS.
BEGIN LINKER;--------------------------------------------------------
LAC PTR,PDLPTR
LAC CHR↔CAIN"⊗"↔GO[PUSH PTR,UNIVERSE↔DAC PTR,PDLPTR↔EXIT0]
CDR 1,PTR↔CAIGE 1,PADPDL+1↔EXIT0 ;STACK EMPTY.
LAC 2,(1)↔LAC CHR
CAIE"."↔CAIN","↔GO L1 ;CLOCK LINK COMMANDS.
CAIN"+"↔GO L1 ;OTHER LINK COMMAND.
CAIN"∩"↔GO[SKIPE CTRL↔JFCL↔DAD 2,2↔GO L0]
CAIN"∪"↔GO[SKIPE CTRL↔JFCL↔SON 2,2↔GO L0]
CAIN"⊂"↔GO[BRO 2,2↔GO L0]
CAIN"⊃"↔GO[SIS 2,2↔GO L0]
CAIE "<"↔CAIN ">"↔ADDI 2,1
CAIE "≤"↔CAIN "≥"↔ADDI 2,2
CAIE "∨"↔CAIN "∧"↔ADDI 2,3
CAIE "←"↔CAIN "→"↔GO[ADDI 2,6↔SKIPN MCBITS↔GO .+1↔GO L6]
SKIPE CTRL↔SUBI 2,4 ;-3 -2 -1
SKIPE META↔ADDI 2,5 ;6 7 8
SKIPE MTCT↔ADDI 2,2 ;4 5 6
LAC 2,(2) ;FETCH WORD FROM THE NODE.
CAIN "≤"↔MOVSS 2
CAIN "<"↔MOVSS 2
CAIN "∨"↔MOVSS 2
CAIN "←"↔MOVSS 2
L0: CDR 2
CAML 44↔GO .+3 ;LOWER THAN MAX.
CAML UNIVER↔DAC(1) ;HIGHER THAN MIN.
EXIT0
;----- LINKER ;OTHER LINK COMMANDS.
L1: CAME 2,UNIVERSE↔TESTZ 2,PBIT↔GO[LAC CHR ;OBJECT CLOCK LINKS.
CAIN"."↔GO[CCW 2,2↔DAC 2,(1)↔EXIT0] ;CCW BODY.
CAIN","↔GO[ CW 2,2↔DAC 2,(1)↔EXIT0] ; CW BODY.
EXIT0]
ANDI 0,17 ;GET TYPE NUMBER
CAIN 0,$TEXT
GO [LAC CHR ;SPECIAL HACK FOR TEXT LIST
CAIN"."↔GO[TCCW 2,2↔SKIPE 2↔DAC 2,(1)↔EXIT0] ;CCW TEXT
CAIN","↔GO[ TCW 2,2↔DAC 2,(1)↔EXIT0] ; CW BODY.
EXIT0]
CAIGE 1,PADPDL+2↔EXIT0 ;TWO ARGUMENTS REQUIRED.
LAC 1,0(PTR)↔LAC 2,-1(PTR)
CALL(LINKED,1,2)↔SKIPN 1↔EXIT0 ;WHICH ARE LINKED.
LAC 1,0(PTR)↔LAC 2,-1(PTR)
SETZ 3,↔LAC CHR
CAIN"+"↔GO L2
CAIE","↔AOS 3 ;DISTINGUISH CW & CCW.
SKIPN CTRL↔ADDI 3,2
SKIPE CTRL↔ADDI 3,4 ;DISTINGUISH OPERATION.
;EDGE IS IN THE FIRST POSITION OF THE STACK.
L2: TEST 1,EBIT↔GO L3 ;EDGE.
TEST 2,FBIT↔GO[TEST 2,VBIT↔EXIT0 ;FACE OR VERTEX.
SKIPE CTRL↔ADDI 3,2↔GO .+1] ;CTRL VERTEX.
PUSH P,1↔PUSH P,2↔PUSHJ P,@L5(3)
CAIN 3,2↔AOS PTR↔CAIN 3,3↔AOS PTR
DAC 1,-1(PTR)↔EXIT0
;EDGE IS IN THE SECOND POSITION OF THE STACK.
L3: TEST 2,EBIT↔EXIT0
TEST 1,FBIT↔GO[TEST 1,VBIT↔EXIT0
SKIPE CTRL↔ADDI 3,2↔GO .+1]
PUSH P,2↔PUSH P,1↔PUSHJ P,@L5(3)
CAIN 3,2↔SOS PTR↔CAIN 3,3↔SOS PTR
DAC 1,0(PTR)↔EXIT0
L5: OTHER↔OTHER↔ECW↔ECCW↔VCW↔VCCW↔FCW↔FCCW
;STEP ALONG IMAGE RINGS OF THE "NOW" CAMERA.
L6: LAC 1,UNIVERSE
NWRLD 1,1↔NCAMR 1,1
SKIPE CTRL↔GO L7
PIMAG 2,1↔SKIPN 2↔EXIT0↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔PIMAG. 3,1
CALL(GEODPY)↔EXIT0
L7: SIMAG 2,1↔SKIPN 2↔EXIT0↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔SIMAG. 3,1
CALL(GEODPY)↔EXIT0
BEND LINKER;2/9/73(BGB)----------------------------------------------
;COMMANDS XNAME,XBODY ;"B","N"
XNAME: ;NAME A BODY
BEGIN XNAME;---------------------------------------------------------
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
LAC 1,(1)↔TEST 1,BBIT↔EXIT0
CALL(RDNAME)
JUMPE 6,[ OUTSTR[ASCIZ/ILLEGAL NAME.
*/]↔ EXIT0]
CALL(FNDNAME)
GO [ LAC 1,PDLPTR↔LAC 1,(1)
DAC 4,-2(1)↔DAC 5,-1(1)
OUTSTR[ASCIZ/*/]↔EXIT0 ]
OUTSTR[ASCIZ/NAME ALREADY IN USE.
*/]↔ EXIT0
BEND XNAME;2/9/73(BGB)-----------------------------------------------
XBODY: ;BODY RETRIEVAL.
BEGIN XBODY;---------------------------------------------------------
LAC PTR,PDLPTR
SKIPN CTRL↔GO[CDR 1,PTR↔CAIGE 1,PADPDL+1↔GO .+1
CALL(BGET,{(PTR)})↔DAC 1,(PTR)↔EXIT0]
CALL(RDNAME)↔JUMPN 6,L2
;FETCH BODY BY ITS SERIAL NUMBER.
LAC 1,UNIVERSE↔NWRLD 1,1 ;GET NOW WORLD.
DAC 1,WORLD↔CCW 1,1
CAME 1,WORLD↔SOJG 3,.-2
CAME 1,WORLD↔GO RET
LOSE: OUTSTR[ASCIZ/BODY NOT FOUND.
*/]↔ EXIT0
;FETCH BODY BY ITS PNAME.
L2: CALL(FNDNAME)↔GO LOSE
RET: PUSH PTR,1
DAC PTR,PDLPTR
OUTSTR[ASCIZ/*/]↔EXIT0
BEND XBODY;2/9/73(BGB)-----------------------------------------------
SUBR(RDNAME)
;--------------------------------------------------------------------
OUTSTR[ASCIZ/ :/]
LACI 2,=10 ;TEN CHARACTERS TO A NAME.
LAC 1,[POINT 7,4,-1]
SETZB 3,6 ;BODY SERIAL NUMBER.
SETZB 4,5
L: CALL(GETCL0)↔CAIN 15↔GO EOL ;END OF LINE.
IDPB 1↔CAIGE"0"↔GO .+3↔CAIG"9"↔GO[
IMULI 3,12↔ANDI 0,17↔ADD 3,0↔GO .+2]
SETOM 6 ;NON-NUMERIC CHR SEEN.
SOJG 2,L
CALL(GETCL0)↔CAIE 15↔GO .-2
CRLF
SKIPA
EOL: CALL(GETCL0)↔EXIT0
ENDR RDNAME;(TVR)----------------------------------------------------
SUBR(FNDNAME) ;FETCH BODY BY ITS PNAME
COMMENT ⊗------------------------------------------------------------
⊗
LAC 1,UNIVERSE↔NWRLD 1,1↔DAC 1,WORLD ;GET "NOW" WORLD.
L1: CCW 1,1↔CAMN 1,WORLD↔EXIT0 ;SCAN THE BODIES.
CAME 4,-2(1)↔GO L1↔CAME 5,-1(1)↔GO L1 ;COMPARE THE NAMES.
AOS(P)↔EXIT0
ENDR FNDNAME;2/9/73(BGB)---------------------------------------------
INSTANT:
BEGIN INSTANT
OPDEF PTO[711440B17]
LAC 1,MCBITS
PTO @[[0↔MACRO0]
[0↔MACRO1]
[0↔MACRO2]
[0↔MACRO3]] (1)
EXIT0
MACRO0: ASCIZ"V\:)\E;E(E:J↑/*S--↑/@/:)\!"
MACRO1: ASCIZ"V:7@S*J!↑8/:\@S)↓>G↑:)!"
MACRO2: ASCIZ"⊗αW↔∪A⊃⊃↔βWA↑βAβAβ/β-λ256
):↔β-);//β\β*(↔β*(λ.25
⊃:↔⊂;\\↑↑βA"
MACRO3: 0
BEND INSTANT;2/9/73(BGB)---------------------------------------------
ATTDET: ;ATTACH-DETACH COMMANDS & FRIENDS.
BEGIN ATTDET;--------------------------------------------------------
EXTERN BDET,BATT,FVDUAL
LAC 1,CHR↔CAIE 1,"D"↔GO L4
;DETACH, αDARKEN, βDUAL, εUNDARKEN.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
LAC 1,(1)↔TEST 1,BBIT↔GO L3
SKIPN MTCT↔GO L2
SLACI 0,(DARKEN)↔SKIPA 2,1 ;UNDARKEN A BODY.
ANDCAM(2)↔PED 2,2↔CAME 1,2↔GO .-3
CALL(GEODPY)↔EXIT0
L2: SKIPE META↔GO[CALL(FVDUAL,1)↔CALL(GEODPY)↔EXIT0]
CALL(BDET,1)↔EXIT0
L3: TEST 1,EBIT↔EXIT0
SLACI 0,(DARKEN)↔IORM(1)↔SKIPE META↔ANDCAM(1)
EXITR
;ATTACH, αNOP, βAXECNT.
L4: SKIPE CTRL↔JFCL
SKIPE META↔GO[AOS 1,AXECNT ;STEP AXECNT.
CAIL 1,4↔LACI 1,1↔DAC 1,AXECNT
EXIT0]
CDR 1,PDLPTR↔CAIGE 1,PADPDL+2↔EXIT0 ;ATTACH.
LAC 2,-1(1)↔LAC 1,(1)
CALL(BATT,1,2)↔EXIT0
BEND ATTDET;2/9/73(BGB)----------------------------------------------
XDPY:
LAC 1,CHR
CAIN 1,"_"↔GO[LAC MCBITS↔DAC DPYFLG↔CALL(GEODPY)↔EXIT0]
CAIE 1,175↔EXIT0
LAC MCBITS↔PUSH P,DPYFLG↔DAC DPYFLG↔DAC ODPYFLG
CALL(GEODPY)↔POP P,DPYFLG↔EXIT0
XCOPY:
BEGIN XCOPY
;βC - MAKE CAMERA IN NOW WORLD.
SKIPE META↔GO[
LAC 1,UNIVERSE↔NWRLD 1,1↔CALL(MKCAMERA↑,1)↔EXITP]
;βC - FETCH CAMERA IN NOW WORLD.
SKIPE CTRL↔GO[LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1↔EXITP]
; C - COPY.
LAC 16,PDLPTR↔CDR 1,16
CAIGE 1,PADPDL+1↔EXIT0
CALL(MKCOPY↑,{(1)})
LACI 2↔DAC DPYFLG↔EXITP ;DON'T OCCULT.
LIT
BEND XCOPY
XIN:
EXTERN ICAM,INCRE ;INPUT FORMAT TYPE-1.
SKIPE CTRL↔GO[SKIPE META
GO [ CALL(IND3D↑)↔CALL(GEODPY)↔EXIT0] ;εI D3D.
CALL(ICAM)↔CALL(GEODPY)↔EXIT0] ;αI CAM.
SKIPE META↔GO[CALL(INCRE)↔CALL(GEODPY)↔EXIT0] ;βI CRE.
CALL(INB3D↑)↔SKIPN 1↔EXIT0 ; I B3D.
CRLF↔OUTCHR["*"]↔EXITP
LIT
XOUT:
EXTERN OCAM,OFORM2
SKIPE CTRL↔GO[SKIPE META
GO[CALL(OUTD3D↑)↔EXIT0] ; εO D3D.
CALL(OCAM)↔EXIT0] ; αO CAM.
SKIPE META↔GO[CALL(OFORM2)↔EXIT0] ; βO TRI.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
CALL(OUTB3D↑,{(1)}) ; O B3D.
EXIT0
LIT
COMHLP: ;HELP COMMAND.
SKIPN CTRL↔GO .+4
SETZB 0,1 ;"αH" CLEAR HELP DISPLAY.
UPGIOT 16,0↔EXIT0
CALL(TVHELP↑,[[SIXBIT/GEOMEDBGB/↔0↔SIXBIT/ SDOC/]])
EXIT0
; W - MAKE WINDOW IN "NOW" DISPLAY RING.
;αW - MAKE WINDOW IN A NEW DISPLAY RING.
;βW - MAKE WORLD AT END OF WORLD RING.
XWMAKE:
BEGIN XWMAKE
SKIPE META↔GO[CALL(MKWORLD↑)↔EXITP]
LAC 1,UNIVERSE↔CW 2,1 ;"NOW" DISPLAY.
NWRLD 1,1↔NCAMR 1,1 ;"NOW" CAMERA.
SKIPE CTRL↔ZAC 2, ;NEW DISPLAY DESIRED.
CALL(MKWINDOW↑,1,2)
EXITP
LIT
BEND XWMAKE
XPLOTO: CALL(PLOTO↑)↔OUTCHR["*"]↔EXIT0
; { } STEP NOW DISPLAY.
;α{ } STEP NOW WORLD.
;β{ } STEP NOW CAMERA OF THE NOW WORLD.
;ε{ } STEP NOW CAMERA OF THE NOW DISPLAY.
XSTEP:
BEGIN XSTEP
LAC 1,UNIVERSE
SKIPE META↔GO L1
SKIPE CTRL↔GO L2
CW 2,1↔ CAIN"}"↔CCW 2,2↔CAIN"{"↔CW 2,2↔CW. 2,1
EXITR
L1: SKIPE CTRL↔CW 1,1 ;NOW DISPLAY.
SKIPN CTRL↔NWRLD 1,1 ;NOW WORLD.
NCAMR 2,1↔JUMPE 2,[EXIT0]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NCAMR. 2,1↔EXITR
L2: NWRLD 2,1↔JUMPE 2,[EXIT0]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NWRLD. 2,1↔EXITR
LIT
BEND XSTEP
XTEXT: ;TEXT COMMAND.
SKIPE CTRL↔GO XTAKE ;SIMULATED TAKE-A-PICTURE.
SKIPE META↔GO XSWEEP ;TRIANGULAR SWEEP
CDR 1,PDLPTR ;GET PDL POINTER
CAIGE 1,PADPDL+1↔EXIT0 ;IS THERE ANYTHING?, IF NOT RETURN
LAC 2,(1) ;GET ARG OFF PDL
TEST 2,VBIT↔EXIT0 ;MUST BE A VERTEX.
; CALL(EDTEXT,2)
JCALL GEODPY
XTAKE: ;MAKE A SYNTHETIC PICTURE.
LAC 1,UNIVERSE
NWRLD 1,1
NCAMR 1,1
CALL(TAKE↑,1) ;CAMERA ARGUMENT.
EXITR
XCONVEX: ;FORCE CONVEX FACES.
SKIPE CTRL↔JFCL
CDR 1,PDLPTR
CAIGE 1,PADPDL+1↔EXIT0
LAC(1)
; CALL(MKCVEX↑,0)
EXITR
XREDPY: ;REDISPLAY.
CALL(STADPY)
PUSH P,DPYFLG
LAC ODPYFLG
DAC DPYFLG
CALL(GEODPY)
POP P,DPYFLG
EXIT0
EXTEND: ;"X"-EXTEND COMMANDS.
BEGIN EXTEND:;-------------------------------------------------------
OUTSTR[ASCIZ/ COMMAND? /]
LAC 1,[POINT 6,3,17] ;SIXBIT CHARACTER TO AC3.
LACI 2,3↔ZAC 3, ;THREE CHARACTERS EXPECTED.
L1: CALL(GETCL0)
CAIE 40↔CAIN 175↔GO L2 ;TEST FOR END OF COMMAND NAME.
CAIN 15↔GO[CALL(GETCL0)↔GO L2]
CAIN "("↔JUMPG 3,L1 ;IGNORE EARLY LEFT PARENS.
CAIN "("↔GO L2
CAIL"a"↔SUBI 40 ;SUPRESS LOWER CASE.
SOJL 2,L1 ;SUPRESS EXCESS LETTERS.
SUBI 40↔IDPB 1↔GO L1 ;PACK CHARACTER INTO AC3.
;SCAN EXTENDED COMMAND JUMP TABLE FOR A MATCH.
L2: LACI 1,BEGXJT↔CDR 2,(1)
CAMN 3,2↔GO[CAR(1)↔GO@]
CAIE 1,ENDXJT↔AOJA 1,L2+1
OUTSTR[ASCIZ/ --- NO SUCH COMMAND.
*/]↔ EXIT0
BEND EXTEND;7/19/73(BGB)---------------------------------------------
;EXTENDED COMMAND JUMP TABLE.
BEGXJT: XWD XCUBE,'CUB' ;MAKE CUBIC PRISM.
XWD XCYLN,'CYL' ;MAKE CYLINDER.
XWD XBALL,'BAL' ;MAKE SPHERE.
XWD XCOLOR,'COL' ;COLORING.
XWD XNSHAR,'NSH' ;EDGES NOT SHARP.
XWD XSCROL,'SCR' ;SCROLL THE CAMERA'S VISIBLE EDGES.
XWD XIGEM,'IGE' ;INPUT GEM FILE.
XWD XOGEM,'OGE' ;OUTPUT GEM FILE.
XWD XCONE,'CON' ;MAKE CONE.
XWD XSEK,'SEK' ;SHORT EDGE KILL.
ENDXJT: XWD [EXIT0],0 ;EMPTY COMMAND.
;EXTEND COMMAND EXECUTIONS.
XCUBE: ;MAKE CUBIC PRISM. "X-CUB".
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-X
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-Y
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-Z
CALL(MKCUBE↑)↔EXITP
XCYLN:
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;RADIUS.
CALL(REALIN)↔PUSH P, ;N SIDES.
CALL(REALIN)↔PUSH P,↔CALL(MKCYLN↑)↔EXITP ;HEIGHT.
XBALL:
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;RADIUS.
CALL(REALIN)↔PUSH P,
CALL(REALIN)↔PUSH P,↔CALL(MKBALL↑)↔EXITP
XNSHARP: ;MARK ALL EDGES NOT-SHARP.
BEGIN NSHARP;--------------------------------------------------------
ACCUMULATORS{B,E}
;GET ARGUMENT FROM TOP OF STACK.
CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔EXIT0
LAC B,(PTR)↔LAC E,B
TEST E,EBIT↔PED E,B ;EDGE OR FIRST EDGE.
L1: TEST E,EBIT↔EXIT1 ;NOT AN EDGE.
MARK E,NSHARP
PED E,E↔GO L1
BEND NSHARP;8/7/73(BGB)----------------------------------------------
XIGEM: CALL(IGEM2↑)↔SKIPN 1↔EXIT0↔EXITP
XOGEM: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
CALL(OGEM2↑,{(1)})↔EXIT1
XCONE: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0↔PUSH P,(1) ;TOP OF STACK.
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;ZDEPTH NEAR.
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;ZDEPTH FAR.
CALL(MKCONE↑)↔EXITP
XSEK:
BEGIN SEK ;SHORT EDGE KILL
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXIT0
LAC 1,(1)↔TEST 1,BBIT↔EXIT0↔DAC 1,B#↔DAC 1,E#
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔DAC TMP#
L1: LAC 1,E↔PED 1,1↔CAMN 1,B↔EXITR
DAC 1,E↔PVT 2,1↔NVT 1,1
CALL(DISTAN↑,1,2)↔CAMLE 1,TMP↔GO L1
CALL(EKILL,E)
LAC 1,B↔DAC 1,E↔GO L1
LIT↔VAR
BEND SEK
XSCROL: ;SCROLL CAMERA VISIBLE EDGES.
BEGIN XSCROL
ACCUMULATORS{W,X,Y,Z,D}
LAC 1,UNIVERSE↔CW 1,1↔DAC 1,WINDOW
LACI 1,=64↔DAC 1,DELTA
CALL(SHOW2↑,WINDOW,[-1]) ;OCCULT - BUT NO KLTEMPS.
OUTSTR[ASCIZ/ #/]
CALL(GETCHW)↔CAIN 1,12 ;SUPPRESS EXTRA LF.
L1: CALL(GETCHW)
CAIE 1,15↔CAIN 1,12↔GO L2
LAC W,WINDOW
NIP X,-3(W)↔NAP Y,-3(W)
LAC Z,-1(W)↔LAC D,DELTA
CAIN 1,"/"↔ASH D,-1↔CAIN 1,"\"↔ASH D,1
CAIN 1,":"↔ADD X,D↔CAIN 1,";"↔SUB X,D
CAIN 1,")"↔ADD Y,D↔CAIN 1,"("↔SUB Y,D
CAIN 1,"*"↔FMP Z,[1.2]↔CAIN 1,"-"↔FMP Z,[0.833334]
DIP X,-3(W)↔DAP Y,-3(W)
DAC Z,-1(W)↔SKIPE D↔DAC D,DELTA
CALL(CROP↑,WINDOW)
CALL(CLIPER↑,WINDOW)
CALL(IIIDPY↑,WINDOW,[1])
GO L1
L2:
LAC W,WINDOW
LAC[3.5]↔DAC -1(W)
SETZM -3(W)
NCAMR 1,W↔PWRLD 1,1
CALL(KLTMPS↑,1) ;KLTEMPS.
EXIT0
DECLARE{WINDOW,DELTA}
BEND XSCROL;8/12/73(BGB)---------------------------------------------
XCOLOR: ;COLORING X-COMMAND.
BEGIN XCOLOR;--------------------------------------------------------
ACCUMULATORS{B,F,W4,W5}
;GET ARGUMENT FROM TOP OF STACK.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔EXIT0
LAC B,(PTR)↔LAC F,B
TEST F,FBIT↔PFACE F,B ;FACE OR FIRST FACE.
TEST F,FBIT↔EXIT0↔PUSH P,F↔PUSH P,B
;OLDE AND NEW VALUES.
LAC 4(F)↔DAC WORD4
LAC 5(F)↔DAC WORD5
DOM ALBEDO↔DOM RED
DOM GRN↔DOM BLU↔GO L1B
;DECODE COLORING ARGUMENTS. 00R 00B 00G 00A
L1: CALL(GETCL0)
CAIE 15↔CAIN 12↔GO L2
L1B: CALL(REALIN)
CAIN 1,"A"↔DACM ALBEDO
CAIN 1,"R"↔DACM RED
CAIN 1,"G"↔DACM GRN
CAIN 1,"B"↔DACM BLU
CAIE 1,15↔GO L1
;SETUP NEW PHOTOMETRIC PARAMETERS.
L2: SKIPGE 1,ALBEDO↔GO L2R ;ALBEDO.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,35]
L2R: SKIPGE 1,RED↔GO L2G ;RED.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,8]
L2G: SKIPGE 1,GRN↔GO L2B ;GREEN.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,17]
L2B: SKIPGE 1,BLU↔GO L3 ;BLUE.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,26]
L3: LAC W4,WORD4↔LAC W5,WORD5↔POPP B↔POPP F
L4: DAC W4,4(F)↔DAC W5,5(F)
CAMN B,F↔EXIT0↔PFACE F,F
CAMN B,F↔EXIT0↔GO L4
DECLARE{ALBEDO,RED,GRN,BLU,WORD4,WORD5}
BEND XCOLOR;7/20/73(BGB)---------------------------------------------
SUBR(STADPY) ;STATUS DISPLAY
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN DECDPY,DPYSTR,DTYO,DPYBRT
EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET,DPYBUF
CALL(DPYSET,DPYBUF)
SKIPN FLAGSD↔GO L4 ;STATUS DISPLAY INHIBIT.
YDEL ←← -=45
;STATUS OF FRAME SELECT.
CALL(AIVECT,[=180],[=500+YDEL])
LAC 1,FRAAM
PUSH P,[
[ASCIZ/WORLD/]
[ASCIZ/BODY/]
[ASCIZ/RELATIVE/]
[ASCIZ/CAMERA/]](1)
CALL(DPYSTR)
;STATUS OF FRAME ORIGIN SWITCH.
LACI[ASCIZ/ FRAME/]
SKIPE FRMORG
LACI[ASCIZ/ FRAME */]
CALL(DPYSTR,0)
;STATUS OF OPERAT SELECT SWITCH.
CALL(AIVECT,[=365],[=500+YDEL])
LAC 1,OPERAT
PUSH P,[
[ASCIZ/TRANSLATION/]
[ASCIZ/ROTATION/]
[ASCIZ/DILATION/]
[ASCIZ/REFLECTION/]](1)
CALL(DPYSTR)
;----- STADPY ;TRANSLATION STRENGTH.
CALL(AIVECT,[=185],[=480+YDEL])
CALL(FLODPY,TDEL,[4])
CALL(DPYSTR,{[[ASCIZ/ FEET/]]})
;ROTATION STRENGTH IN PI FRACTION.
CALL(AIVECT,[=185],[=460+YDEL])
L1: LAC RDEL↔LAC 1,[3.15]
CAMLE[6.28]↔GO L2
CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
CALL(DTYO,["2"])↔POP P,1
GO .+1]
FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
CALL(DPYSTR,{[[ASCIZ"π/"]]})
CALL(DECDPY)
L2:
;ROTATION STRENGTH IN RADIANS.
CALL(AIVECT,[=400],[=460+YDEL])
CALL(FLODPY,RDEL,[3])
;RDEL IN DEGREES, MINUTES AND SECONDS.
CALL(AIVECT,[=270],[=460+YDEL])
LAC 1,RDEL
FMPR 1,[206264.806]
FIX 1,233000
AOS 1
IDIVI 1,=3600
IDIVI 2,=60
PUSH P,3
PUSH P,2
PUSH P,1
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)
;DILATION STRENGTH.
CALL(AIVECT,[=390],[=480+YDEL])
LAC DDEL↔FMP[100.0]↔FADR[0.001]
CALL(FLODPY,0,[2])
CALL(DTYO,["%"])
CALL(DTYO,[" "])
LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
;----- STADPY DISPLAY THE SCRATCH PAD PDL.
CALL(AIVECT,[-=511],[=430])
CDR 16,PDLPTR
CAILE 16,PADPDL↔GO[
CALL(IDPY,{(16)})
CALL(NTYPE,{(16)})
CAIN 1,$YNODE↔GO $.+3
CAIG 1,$BODY↔GO NOTFEV
CALL(DPYSTR,[[ASCIZ/ of /]])
CALL(BGET,{(16)})
CALL(IDPY,1)
NOTFEV: CALL(DTYO,[15])↔CALL(DTYO,[12])
SOJA 16,.-1]
SKIPN FLAGL↔GO L3
;DISPLAY TOP OBJECT OF PADPDL.
CDR 16,PDLPTR↔CAILE 16,PADPDL
GO[CALL(DPYTOP,{(16)})↔GO .+1]
;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
CDR 16,PDLPTR↔CAILE 16,PADPDL+1
GO[ LAC 1,-1(16)↔LAC 2,(16)
LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
CAIE 6↔CAIN 3↔SKIPA↔GO .+1
CALL(LINKED,1,2)↔JUMPE 1,.+1
CALL(DPYTOP,{-1(16)})
GO .+1]
L3: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L4↔LAC 1,(1)
SKIPE FLAGD↔GO[CALL(DPYNODE,1)↔GO L4]
L4: CALL(DPYOUT,[0])
POP0J
ENDR STADPY;2-FEB-73(BGB)
SUBR(NTYPE,NODE) ;FETCH NODE TYPE NUMBER 0 TO 17.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,@NODE ;TYPE BITS WORD.
SKIPGE 1↔SETZ 1, ;NEGATIVE BIT.
TLNE 1,(1B9)↔SETZ 1, ;NORMALIZATION BIT.
ANDI 1,17↔POP1J
ENDR NTYPE;3/25/73(BGB)----------------------------------------------
SUBR(DPYTOP,OBJECT) ;SPECIAL ENTITY DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(NTYPE,OBJECT)
CAIGE 1,$YNODE↔POP1J
GO @[ POP1J. ;YNODE
POP1J. ;ZNODE
POP1J. ;BODY
FDPY ;FACE
EDPY ;EDGE
VDPY ;VERTEX
]-$YNODE(1)
ENDR DPYTOP;---------------------------------------------------------
;TABLES REL,CONTYP,NNAMES,NLETTER ;Node Info. Tables
;NODE RELLOCATION BITS.
; 0 1 2| 3 4 5| 6 7 8| 9 10 11|12 13 14|15 16 17| ← BIT.
; | 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
REL↑:
BEGIN REL
L8←←<(4000)>↔ R8←←4000 ↔ L7←←<(2000)>↔ R7←←2000
L6←←<(1000)>↔ R6←←1000 ↔ L5←←<(400)>↔ R5←← 400
L4←←<(200)>↔ R4←← 200 ↔ L3←←<(100)>↔ R3←← 100
L2←← <(40)>↔ R2←← 40 ↔ L1←← <(20)>↔ R1←← 20
NL1←← <(4)>↔NR1←← 4 ↔ NL2←← <(2)>↔NR2←← 2
NL3←← <(1)>↔NR3←← 1
0 ↔ NR3 ;FRAME & EMPTY.
L7+R7+L4+R4+NR2 ;UNIVERSE.
L6+R5+L5 ;LAMP.
L7+R7 + R6 + L5+R5 +R4 ;CAMERA.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;WORLD.
L7+R7 + L5+R5 + L4 ;WINDOW.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;IMAGE.
XWD 0004, 0004 ;TEXT.
0↔0↔0 ;X,Y,Z NODES.
XWD 3760, 3760 ;BODY.
XWD 1020, 1060 ;FACE.
XWD 3760, 3760 ;EDGE.
XWD 0140, 0140 ;VERTEX.
BEND
NLETTER↑: ;NODE INITIALS.
"R" ↔ "M" ↔ "U" ↔ "S"
"C" ↔ "W" ↔ "D" ↔ "I"
"T" ↔ "X" ↔ "Y" ↔ "Z"
"B" ↔ "F" ↔ "E" ↔ "V"
NNAMES↑: ;NODE NAMES
[ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"SUN"]
[ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
[ASCIZ"TEXT"]↔[ASCIZ"XNODE"]↔[ASCIZ"YNODE"]↔[ASCIZ"ZNODE"]
[ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]
SUBR(JDPY,NODE) ;DISPLAY NODE'S NUMERAL.
SKIPN 1,NODE↔GO[
CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CAMGE 1,UNIVERSE↔GO L
CAML 1,44↔GO L
CALL(NTYPE,1)
CALL(DTYO,{NLETTER(1)})
L: CALL({OCTDPY},NODE)
POP1J
ENDR JDPY;3/25/73(BGB)-----------------------------------------------
;NODE CONTENT TYPES.
COMMENT ⊗
0 -- EMPTY.
1 -- OCTAL WORD.
2 -- ASCII.
3 -- REAL.
4 -- NODE.
| 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
⊗
CONTYP:
BYTE(9)333,333,333,333 ;FRAME.
BYTE(9)000,000,000,000 ;EMPTY.
BYTE(9)040,040,001,000 ;UNIVERSE.
BYTE(9)000,400,001,000 ;LAMP.
BYTE(9)044,440,001,000 ;CAMERA.
BYTE(9)044,440,441,220 ;WORLD.
BYTE(9)040,440,001,300 ;WINDOW.
BYTE(9)044,440,001,000 ;IMAGE.
BYTE(9)000,000,001,000 ;TEXT.
0 ;XNODE.
0 ;YNODE.
0 ;ZNODE.
BYTE(9)044,444,441,220 ;BODY.
BYTE(9)004,113,041,333 ;FACE.
BYTE(9)044,444,441,000 ;EDGE.
BYTE(9)003,334,411,333 ;VERTEX.
SUBR(DPYNODE,NODE) ;DISPLAY NODE CONTENTS.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN AIVECT,AVECT,DPYBIG
EXTERN DTYO,DPYSTR,FLODPY,DECDPY,OCTDPY
;BOX IN LOWER RIGHT HAND CORNER OF THE SCREEN
CALL(AIVECT,[=260],[-=70])
CALL(AVECT,[=260],[-=380])
CALL(AVECT,[=508],[-=380])
CALL(AVECT,[=508],[-=70])
CALL(AVECT,[=260],[-=70])
CALL(DPYBIG,[1])↔CALL(JDPY,NODE)↔SKIPN NODE↔POP1J
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,NODE})
LAC [POINT 7,LNKCHR]↔DAC LNKPTR
CAIN 1,$YNODE
GO [ LAC 2,NODE↔LAC 0,YREL(2)↔GO .+2 ] ;YNODES
LAC REL(1)↔DAC RELTMP ;RELLOCATION.
LAC CONTYP(1)↔DAC CONTMP ;CONTENT TYPE.
LAC NNAMES(1)↔CALL(DPYSTR,0)
NIM -3↔DAC WRD
L1:
LACN WRD↔IMULI =25↔SUBI =170↔DAC Y
CALL(AIVECT,[=265],Y)
ILDB 1,LNKPTR ;PICK UP LINK CHARACTERS (LEFT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BETWEEN THEM
ILDB 1,LNKPTR ;(RIGHT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BEFORE A NUMBER
SKIPGE WRD↔GO .+3↔CALL(DTYO,[" "]) ;AND ANOTHER IF NOT NEGATIVE
CALL(DECDPY,WRD)
;FULL WORD.
CALL(AIVECT,[=345],Y)
LACN 2,WRD↔LAC CONTMP
ROT(2)↔ROT(2)↔ROT(2)↔ANDI 7000
CAIN 3000↔GO[LAC 1,NODE↔ADD 1,WRD
CALL(FLODPY,{(1)},[4])↔GO L2]
;LEFT HALF.
CALL(AIVECT,[=345],Y)
LAC 1,NODE↔ADD 1,WRD↔CAR(1)↔PUSH P,0
LACN 2,WRD↔CAR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY})
;RIGHT HALF.
CALL(AIVECT,[=425],Y)
LAC 1,NODE↔ADD 1,WRD↔CDR(1)↔PUSH P,0
LACN 2,WRD↔CDR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY})
L2: AOS 1,WRD↔CAIG 1,8↔GO L1
CALL(DPYBIG,[2])
POP1J
LNKCHR: ASCIZ/ <>≤≥∨∧∩∪⊂⊃←→,./
DECLARE{WRD,X,Y,KIND,RELTMP,CONTMP,LNKPTR}
ENDR DPYNODE;3/25/73(BGB)--------------------------------------------
SUBR(SEENODE,NODE)---------------------------------------------------
PUSHACS
CALL(DPYSET,DPYBUF)
CALL(DPYNODE,NODE)
CALL(DPYTOP,NODE)
CALL(DPYOUT,[0])
POPACS
POP1J
ENDR SEENODE;5/4/73(TVR)---------------------------------------------
SUBR(VDPY,VERTEX) ;SPECIAL VERTEX DISPLAY *
LAC 1,VERTEX
TESTZ 1,NSEW+PZZ↔POP1J
XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
CALL(DPYBIG↑,[1])↔CALL(DPYBRT,[3])
CALL(IDPY,VERTEX)
CALL(DPYBIG↑,[2])↔CALL(DPYBRT,[2])
POP1J
ENDR VDPY;9-JAN-73(BGB)9-FEB-73(BGB)
SUBR(EDPY,EDGE) ;SPECIAL EDGE DISPLAY *
CALL(DPYBIG↑,[1])↔CALL(DPYBRT,[4])
LAC 2,EDGE↔PVT 1,2
TESTZ 1,NSEW!PZZ↔GO L1
XDC 0,1↔FIXX↔DAC X
YDC 0,1↔FIXX↔DAC Y↔CALL(AIVECT,X,Y)
CALL(DTYO,["+"])↔ CALL(AIVECT,X,Y)
L1: LAC 2,EDGE↔NVT 1,2
TESTZ 1,NSEW!PZZ↔GO L2
XDC 0,1↔FIXX↔ADDM X↔PUSH P,
YDC 0,1↔FIXX↔ADDM Y↔PUSH P,↔CALL(AVECT)
CALL(DTYO,["-"])
L2: LAC 2,EDGE
LAC X↔ASH -1↔PUSH P,
LAC Y↔ASH -1↔PUSH P,↔CALL(AIVECT)
CALL(IDPY,EDGE)
CALL(DPYBIG,[2])
CALL(DPYBRT↑,[2])
CALL(AIVECT,[0],[0]) ;FORCE BIG & BRT RESET.
POP1J
DECLARE{X,Y}
ENDR EDPY;9-FEB-73(BGB)
SUBR(FDPY,FACE) ;Special Face display *
EXTERN ECCW
LAC 1,FACE↔DAC 1,F↔TEST 1,FBIT↔POP1J
PED 2,1↔DAC 2,E↔DAC 2,E0↔JUMPE 2,POP1J.
SETZM I
CALL(DPYBIG,[1])
CALL(DPYBRT↑,[3])
SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
X1DC 0,2↔DAC 0,X
Y1DC 1,2↔DAC 1,Y
CALL(AIVECT,0,1)↔LAC 2,E
X2DC 0,2↔ADDM 0,X
Y2DC 1,2↔ADDM 1,Y
CALL(AVECT,0,1)
LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
CALL(AIVECT,0,1)
CALL(DECDPY,I)
L2: CALL(ECCW,E,F)
CAMN 1,E↔GO L3↔DAC 1,E
CAME 1,E0↔GO L1
L3: CALL(DPYBRT↑,[2])
CALL(DPYBIG,[2])
POP1J
DECLARE{F,E,E0,X,Y,I}
ENDR FDPY;9-FEB-73(BGB)
SUBR(IDPY,NODE) ;Identifier display. *
;--------------------------------------------------------------------
SKIPN NODE↔GO[CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CALL(NTYPE,NODE)↔CAIGE 1,$BODY↔GO L5
LAC 1,NODE↔SETZ 2,
TESTZ 1,BBIT↔GO[
SKIPE 13,-2(1)↔GO[
LAC 14,-1(1)↔DZM 15
CALL(DPYSTR,[13])↔POP1J]
L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
CALL(DECDPY)↔POP1J]
TESTZ 1,FBIT↔GO[
L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
CALL(DECDPY)↔POP1J]
TESTZ 1,EBIT↔GO[
L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
CALL(DECDPY)↔POP1J]
TESTZ 1,VBIT↔GO[
L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
CALL(DECDPY)↔POP1J]
CALL NTYPE,NODE
L5: CALL DPYSTR,NNAMES(1)
LAC 1,NODE↔CAMN 1,UNIVERSE↔POP1J
$TYPE 2,1↔DZM 5 ;NODE - TYPE - COUNT.
LAC 3,UNIVERSE↔SON 3,3↔DAC 3,4 ;SON0 - SON.
CAME 1,4↔GO[$TYPE 0,4↔CAMN 0,2↔AOS 5↔SIS 4,4
CAME 3,4↔GO .-1↔GO .+1]↔AOS 5
CALL(DECDPY,5)
POP1J
ENDR IDPY;2/4/73(BGB)------------------------------------------------
IFE SAIL{END SA}
IFN SAIL{END}
GEOMED.FAI - EOF.